home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / textFill.tcl < prev    next >
Encoding:
Text File  |  2001-01-04  |  7.7 KB  |  272 lines
  1. ####################################################################
  2. #  AlphaTcl - core Tcl engine
  3. # 
  4. # Much by Vince Darley.
  5. # 
  6. #                                    created: 26/11/96 {7:08:34 pm} 
  7. #                                last update: 01/04/2001 {22:46:50 PM}
  8. #  Author: Vince Darley
  9. #  E-mail: <vince@santafe.edu>
  10. #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501, USA
  11. #     www: <http://www.santafe.edu/~vince/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  #       
  17.  # 'rememberWhereYouAre'
  18.  # 
  19.  #  Given the start of a paragraph and the point to remember, this returns a
  20.  #  record which must be passed to the following function so that it can
  21.  #  find the spot later, even after the paragraph has had
  22.  #  space/tabs/new-lines meddled with.  An optional last argument is a list
  23.  #  of other characters quoted so they are regexp insensitive, which should
  24.  #  also be ignored.  This is used so we can remember positions in text
  25.  #  which has cosmetic characters on the left/right which are not wrapped
  26.  #  (such as the hashes to the left here!).
  27.  #       
  28.  # 'goBackToWhereYouWere'
  29.  # 
  30.  #  Given the beginning and end of a selection, and a previous record, where
  31.  #  the beginning, and record correspond to a previous call of
  32.  #  'rememberWhereYouAre', this procedure will move the insertion point to
  33.  #  the correct place.
  34.  #       
  35.  ##
  36.  
  37. proc rememberWhereYouAre {startPara pos endPara {commentReg ""}} {
  38.     set start [pos::math $pos -20]
  39.     if {[pos::compare $start < $startPara]} {
  40.     set start $startPara
  41.     }
  42.     set __g_remember_str [getText $start $pos]
  43.     if {[string length [string trim $__g_remember_str]] < 3} {
  44.     # there wasn't much to remember; try the other way
  45.     set end [pos::math $pos +20]
  46.     if {[pos::compare $end > $endPara]} {
  47.         set end $endPara
  48.     }
  49.     set __g_remember_str [getText $pos $end]
  50.     set __g_remember_dir 0
  51.     } else {
  52.     set __g_remember_dir 1
  53.     }
  54.     
  55.     set __g_remember_str [quote::Regfind $__g_remember_str]
  56.     regsub -all "\[ \t\r\n${commentReg}\]+" $__g_remember_str \
  57.       {[ \t\r\n${commentReg}]+} __g_remember_str
  58.     return [list $__g_remember_str $__g_remember_dir]
  59. }
  60.  
  61. proc goBackToWhereYouWere {start end memory} {
  62.     if {[lindex $memory 0] != "" } {
  63.     regexp -indices ".*([lindex $memory 0]).*" [getText $start $end] \
  64.       "" submatch
  65.     if {[info exists submatch]} {
  66.         set p [pos::math $start + [lindex $memory 1] + \
  67.           [lindex $submatch [lindex $memory 1]]]
  68.     } else {
  69.         set p $end
  70.     }
  71.     goto [expr {[pos::compare $p >= $end] ? [pos::math $end - 1] : $p}]
  72.     } else {
  73.     goto $start
  74.     }
  75. }
  76.  
  77. ## 
  78.  # -------------------------------------------------------------------------
  79.  #     
  80.  #    "getLeadingIndent" --
  81.  #    
  82.  #  Find the indentation of the line containing 'pos', and convert it to a
  83.  #  minimal form of tabs followed by spaces.  If 'size' is given, then the
  84.  #  variable of that name is set to the length of the indent.  Similarly
  85.  #  'halftab' can be set to half a tab. 
  86.  # -------------------------------------------------------------------------
  87.  ##
  88. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  89.     # get the leading whitespace of the current line
  90.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  91.     
  92.     # convert it to minimal form: tabs then spaces, stored in 'front'
  93.     getWinInfo a
  94.     set sp [string range "              " 1 $a(tabsize) ]
  95.     regsub -all "($sp| +\t)" [eval getText $res] "\t" front
  96.     if { $size != "" } {
  97.     upvar $size ind
  98.     # get the length of the indent
  99.     regsub -all "\t" $front $sp lfront
  100.     set ind [string length $lfront]
  101.     }
  102.     if { $halftab != "" } {
  103.     upvar $halftab ht
  104.     # get the length of half a tab
  105.     set ht [string range "            " 1 [expr {$a(tabsize)/2}]]
  106.     }
  107.     
  108.     return $front
  109. }
  110.  
  111.  
  112. proc getEndpts {} {
  113.     if {[pos::compare [getPos] == [selEnd]]} {
  114.     set start [getPos]
  115.     set finish [getMark]
  116.     if {[pos::compare $start > $finish]} {
  117.         set temp $start
  118.         set start $finish
  119.         set finish $temp
  120.     }
  121.     } else {
  122.     set start [getPos]
  123.     set finish [selEnd]
  124.     }
  125.     return [list $start $finish]
  126. }
  127.  
  128.  
  129. proc fillRegion {} {
  130.     global leftFillColumn
  131.     set ends [getEndpts]
  132.     set start [lineStart [lindex $ends 0]]
  133.     set finish [lindex $ends 1]
  134.     goto $start
  135.     set text [fillText $start $finish]
  136.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  137. }
  138.     
  139. proc wrapParagraph {} {
  140.     set pos [getPos]
  141.     set start [paragraph::start $pos] 
  142.     set finish [paragraph::finish $pos]
  143.     goto $start
  144.     wrapText $start $finish
  145.     goto $pos
  146. }
  147.  
  148. proc wrapRegion {} {
  149.     set ends [getEndpts]
  150.     set start [lineStart [lindex $ends 0]]
  151.     set finish [lindex $ends 1]
  152.     if {[pos::compare $start == $finish]} {
  153.     set finish [maxPos]
  154.     }
  155.     wrapText $start $finish
  156. }
  157.     
  158.  
  159.  
  160. # Remove text from window, transform, and insert back into window.
  161. proc fillText {from to} {
  162.     global doubleSpaces
  163.     set text [getText $from $to]
  164.     regexp "^\[ \t\]*" $text front
  165.     regsub -all "\[ \t\n\r\]+" [string trim $text] " " text
  166.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  167.     regsub -all " ?\[\r\n\]" [string trimright [breakIntoLines $text]] "\r${front}" text
  168.     return $front$text
  169. }
  170.  
  171. proc paragraphToLine {} {
  172.     global fillColumn
  173.     global leftFillColumn
  174.     set fc $fillColumn
  175.     set lc $leftFillColumn
  176.     set fillColumn 10000
  177.     set leftFillColumn 0
  178.     fillRegion
  179.     set fillColumn $fc
  180.     set leftFillColumn $lc
  181. }
  182.  
  183. proc lineToParagraph {} {
  184.     global fillColumn
  185.     global leftFillColumn
  186.     set fc $fillColumn
  187.     set fillColumn 75
  188.     set lc $leftFillColumn
  189.     set leftFillColumn 0
  190.     fillRegion
  191.     set fillColumn $fc
  192.     set leftFillColumn $lc
  193. }
  194.  
  195.  
  196. #set sentEnd {[.!?](\r|\n| +)}
  197. set sentEnd {(\r\r|\n\n|[.!?](\r|\n| +))}
  198. set sentBeg {[\r\n ][A-Z]}
  199.  
  200. proc sentenceRegion {} {
  201.     set ends [getEndpts]
  202.     set start [lineStart [lindex $ends 0]]
  203.     set finish [lindex $ends 1]
  204.     if {[pos::compare $start == $finish]} {
  205.     set finish [maxPos]
  206.     }
  207.     set t [string trim [getText $start $finish]]
  208.     set period [regexp {\.$} $t]
  209.     regsub -all "\[ \t\r\n\]+" $t " " text
  210.     regsub -all {\. } $text " " text
  211.     set result ""
  212.     foreach line [split [string trimright $text {.}] " "] {
  213.     if {[string length $line]} {
  214.         append result [breakIntoLines $line] ".\r"
  215.     }
  216.     }
  217.     if {!$period && [regexp {\.\r} $result]} {
  218.     set result [string trimright $result ".\r"]
  219.     append result "\r"
  220.     }
  221.     if {$result != [getText $start $finish]} {
  222.     replaceText $start $finish $result
  223.     }
  224.     goto $pos
  225. }
  226.  
  227. proc nextSentence {} {
  228.     global sentBeg sentEnd
  229.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  230.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  231.         goto [pos::math [lindex $mtch 0] + 1]
  232.     }
  233.     }
  234. }
  235.  
  236.  
  237. proc prevSentence {} {
  238.     global sentBeg sentEnd
  239.     if {[catch {search -s -f 0 -r 1 $sentBeg [pos::math [getPos] - 2]} mtch]} return
  240.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  241.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  242.         goto [pos::math [lindex $mtch 0] + 1]
  243.     }
  244.     }
  245. }
  246.  
  247. #===============================================================================
  248. # Called by Alpha to do "soft wrapping"
  249. proc softProc {pos start next} {
  250.     global leftFillColumn
  251.     goto $start
  252.     set finish [paraFinish $start]
  253.     set text [fillText $start $finish]
  254.     if {"${text}\r" != [getText $start $finish]} {
  255.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  256.     return 1
  257.     } else {
  258.     return 0
  259.     }
  260. }
  261.  
  262. proc dividingLine {} {
  263.     global mode
  264.     global ${mode}modeVars
  265.     if {[info exists ${mode}modeVars(prefixString)]} {
  266.     set a [string trim [set ${mode}modeVars(prefixString)]]
  267.     } else {
  268.     set a "#"
  269.     }
  270.     insertText "${a}===============================================================================\r"
  271. }
  272.